home *** CD-ROM | disk | FTP | other *** search
/ Shareware Extravaganza - Disc 4 / Shareware Extravaganza - Over 25,000 Programs (The Ultimate Shareware Company)(Disc 4 of 4)(1993).iso / cad / quikcmd2.zip / SSETS.LSP < prev    next >
Text File  |  1990-10-23  |  7KB  |  240 lines
  1. ;  SSETS.LSP
  2. ;
  3. ;                         QUICK COMMAND version 2.0
  4. ;                   SSETS.LSP is a module of QUICK COMMAND
  5. ;                        Copyright 1989, 1990 Dan Jincks
  6. ;
  7. ;
  8. ;              This is SHAREWARE, it is NOT Public Domain software.
  9. ;
  10. ;              This code or any part of this code may not be reproduced
  11. ;              in any publication without prior written permission.
  12. ;
  13. ;              Printed copy of this code or any part of this code may not
  14. ;              be distributed without prior written permission.
  15. ;
  16. ;              Printed copy may only be made for reference purposes by
  17. ;              the end user.
  18. ;
  19. ;
  20. ;                               Dan Jincks
  21. ;                             Box 155A HCR 77
  22. ;                           Annapolis, MO 63620
  23. ;
  24. ;
  25. ;
  26. ;   You are granted a limited license to use SSETS.LSP for a 30 day trial
  27. ;   period.  If you wish to continue using any or all of QUICK COMMAND after
  28. ;   the trial period, you must become a registered user.  As a registered
  29. ;   user, you may use QUICK COMMAND on 1 workstation or terminal.
  30. ;   Additional registrations must be bought for each additional workstation or
  31. ;   terminal.  To become a registered user, fill out the order form that can
  32. ;   be printed out from ORDERQC.DOC .
  33. ;
  34. ;
  35. ;   You may send copies of QUICK COMMAND to friends and associates if you abide
  36. ;   by the following rules:
  37. ;
  38. ;   1. It may only be distributed in the original unmodified form.
  39. ;   2. All original files must be included.
  40. ;   3. No addition files may be added.
  41. ;   4. If other files will be on the same disk, QUICK COMMAND files must be in
  42. ;      a library format such as ".ARC" called "QUICKCMD", or else be put alone
  43. ;      in a subdirectory called "QUICKCMD".
  44. ;   5. You may not sell QUICK COMMAND or any part of it.
  45. ;   6. You are not allowed to charge more then $5 to cover the cost of copying
  46. ;      and distribution.
  47. ;   7. You may not distribute any hard copy of the contents of QUICK COMMAND.
  48. ;
  49. ;
  50. ;   These AutoLISP commands and functions are designed to save you time, and
  51. ;   saving time means saving money.  The registration fee is very modest
  52. ;   compared to the savings, and much less expensive then typical third party
  53. ;   AutoCAD software. Be sure to registar if you continue to use them.
  54. ;
  55. ;
  56. ;                                                               DAN
  57. ;
  58. ;
  59. ;
  60. ;
  61. ;        AutoCAD and AutoLISP are registered trade marks of Autodesk Inc.
  62. ;
  63. ;        ***************************************************************
  64. ;
  65. ;   Begin SSETS.LSP
  66. ;
  67. ;
  68. (defun C:S1S ()(terpri)
  69.    (prompt " Construct selection set SS1 for use in this editing session. . .")
  70.    (terpri)
  71.    (prompt " Type !SS1 to recall in a command. ")
  72.    (terpri)
  73.    (setq SS1 (ssget))
  74. )
  75. ;
  76. (defun C:S2S ()(terpri)
  77.    (prompt " Construct selection set SS2 for use in this editing session. . .")
  78.    (terpri)
  79.    (prompt " Type !SS2 to recall in a command. ")
  80.    (terpri)
  81.    (setq SS2 (ssget))
  82. )
  83. ;
  84. (defun C:S1A(/ SCE SCA SCB SCC)
  85.    (prompt "Select objects to add to set SS1. . .  ")(terpri)
  86.    (setq SCA (getvar "blipmode"))
  87.    (setvar "blipmode" 1)
  88.    (setvar "cmdecho" 0)
  89.    (command "select" SS1)
  90.    (setq SCB 0)
  91.    (setq SCC (ssget))
  92.    (command "")
  93.    (setq SCE (ssname SCC SCB))
  94.    (while (/= SCE nil)(progn
  95.       (ssadd SCE SS1)
  96.       (setq SCB (1+ SCB))
  97.       (setq SCE (ssname SCC SCB))
  98.       )
  99.    )
  100.    (prompt "New SS1 is highlighted...  Press <ENTER>")
  101.    (command "select" SS1 pause)
  102.    (setvar "cmdecho" 1)
  103.    (setvar "blipmode" SCA)(princ)
  104. )
  105. ;
  106. (defun C:S2A(/ SCE SCA SCB SCC)
  107.    (prompt "Select objects to add to set SS2. . .  ")(terpri)
  108.    (setq SCA (getvar "blipmode"))
  109.    (setvar "blipmode" 1)
  110.    (setvar "cmdecho" 0)
  111.    (command "select" SS2)
  112.    (setq SCB 0)
  113.    (setq SCC (ssget))
  114.    (command "")
  115.    (setq SCE (ssname SCC SCB))
  116.    (while (/= SCE nil)(progn
  117.       (ssadd SCE SS2)
  118.       (setq SCB (1+ SCB))
  119.       (setq SCE (ssname SCC SCB))
  120.       )
  121.    )
  122.    (prompt "New SS2 is highlighted...  Press <ENTER>")
  123.    (command "select" SS2 pause)
  124.    (setvar "cmdecho" 1)
  125.    (setvar "blipmode" SCA)(princ)
  126. )
  127. ;
  128. (defun C:S1R(/ SCE SCA)
  129.    (prompt "Pick objects to remove from set SS1. . .  ") (terpri)
  130.    (setq SCA (getvar "blipmode"))
  131.    (setvar "blipmode" 1)
  132.    (setvar "cmdecho" 0)
  133.    (command "select" SS1)
  134.    (setq SCE (entsel))
  135.    (while (/= SCE nil)(progn
  136.       (command "")
  137.       (setq SCE (car SCE))
  138.       (ssdel SCE SS1)
  139.       (command "select" SS1)
  140.       (setq SCE (entsel))
  141.       )
  142.    )
  143.    (command "")
  144.    (setvar "cmdecho" 1)
  145.    (setvar "blipmode" SCA)
  146. )
  147. ;
  148. (defun C:S2R(/ SCE SCA)
  149.    (prompt "Pick objects to remove from set SS2. . .  ") (terpri)
  150.    (setq SCA (getvar "blipmode"))
  151.    (setvar "blipmode" 1)
  152.    (setvar "cmdecho" 0)
  153.    (command "select" SS2)
  154.    (setq SCE (entsel))
  155.    (while (/= SCE nil)(progn
  156.       (command "")
  157.       (setq SCE (car SCE))
  158.       (ssdel SCE SS2)
  159.       (command "select" SS2)
  160.       (setq SCE (entsel))
  161.       )
  162.    )
  163.    (command "")
  164.    (setvar "cmdecho" 1)
  165.    (setvar "blipmode" SCA)
  166. )
  167. ;
  168. (defun C:S1H (/ SCA)
  169.    (setq SCA (getvar "cmdecho"))
  170.    (setvar "cmdecho" 0)
  171.    (prompt "Selection set SS1 is highlighted...  Press ENTER ")
  172.    (command "select" SS1 pause )
  173.    (setvar "cmdecho" SCA)
  174. )
  175. (defun C:S2H (/ SCA)
  176.    (setq SCA (getvar "cmdecho"))
  177.    (setvar "cmdecho" 0)
  178.    (prompt "Selection set SS2 is highlighted...  Press ENTER ")
  179.    (command "select" SS2 pause )
  180.    (setvar "cmdecho" SCA)
  181. )
  182. ;
  183. (defun C:S2F1 (/ SCA SCB SCC SCD SCE)
  184.    (setvar "cmdecho" 0)
  185.    (command "select" SS1)
  186.    (initget 1 "Line Circle Point POLyline Arc Text")
  187.    (setq SCA (strcase (getkword "Type of entity in SS1 to be put into SS2.
  188.    Line, Circle, Arc, Point, Text or POLyline...  ")))(terpri)
  189.    (prompt "         working... please wait...     ")(terpri)
  190.    (command "")
  191.    (if (= SS2 nil)(progn
  192.       (setq SS2 (ssadd))))
  193.    (setq SCC 0)
  194.    (setq SCE (ssname SS1 SCC))
  195.    (while (/= SCE nil)(progn
  196.       (setq SCB (entget SCE ))
  197.       (setq SCD (cdr (assoc 0 SCB)))
  198.       (if (= SCD SCA)(progn
  199.          (ssadd SCE SS2)
  200.          )
  201.       )
  202.    (setq SCC (1+ SCC))
  203.    (setq SCE (ssname SS1 SCC))
  204.    (if (= SCE nil)(progn
  205.       (prompt "  Done...  SS2 is highlighted...   Press enter to continue ")
  206.       (command "select" SS2 pause )
  207.       (setvar "cmdecho" 1)))
  208.    ))(princ)
  209. )
  210. ;
  211. (defun C:S1F2 (/ SCA SCB SCC SCD SCE)
  212.    (setvar "cmdecho" 0)
  213.    (command "select" SS2)
  214.    (initget 1 "Line Circle Point POLyline Arc Text")
  215.    (setq SCA (strcase (getkword "Type of entity in SS2 to be put into SS1.
  216.    Line, Circle, Arc, Point, Text or POLyline...  ")))(terpri)
  217.    (prompt "         working... please wait...     ")(terpri)
  218.    (command "")
  219.    (if (= SS1 nil)(progn
  220.       (setq SS1 (ssadd))))
  221.    (setq SCC 0)
  222.    (setq SCE (ssname SS2 SCC))
  223.    (while (/= SCE nil)(progn
  224.       (setq SCB (entget SCE))
  225.       (setq SCD (cdr (assoc 0 SCB)))
  226.       (if (= SCD SCA)(progn
  227.          (ssadd SCE SS1)
  228.          )
  229.       )
  230.    (setq SCC (1+ SCC))
  231.    (setq SCE (ssname SS2 SCC))
  232.    (if (= SCE nil)(progn
  233.       (prompt "  Done...  SS1 is highlighted...   Press enter to continue ")
  234.       (command "select" SS1 pause )
  235.       (setvar "cmdecho" 1)))
  236.    ))(princ)
  237. )
  238. ;
  239. ;   End SSETS.LSP
  240.